perm filename CROP.SAI[PIC,HE] blob sn#430355 filedate 1979-04-04 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY CROP,CROPPL
C00004 ENDMK
C⊗;
ENTRY CROP,CROPPL;
BEGIN "CROP"
REQUIRE "BUFDEC" SOURCE!FILE;
INTERNAL SIMPLE INTEGER PROCEDURE CROP(INTEGER BUFF,SI,EI,SJ,EJ);
    BEGIN "CROPX"
    INTEGER I,J,PTR,OPTR,OBUF,SAV;
    SAV←1;
    GETBUF(EI-SI+1,EJ-SJ+1,BYTSZ(BUFF),OBUF←FNDBUF);
    PUTSUB(ISUBST(BUFF)+SI-1,JSUBST(BUFF)+SJ-1,OBUF);
    COPHDR(BUFF,OBUF);
    FOR I←SI STEP 1 UNTIL EI DO
	BEGIN
	PTR←INPTR(I,SJ,BUFF);
	OPTR←OUTPTR(SAV,1,OBUF);
	FOR J←SJ STEP 1 UNTIL EJ DO
		IDPB(ILDB(PTR),OPTR);
	SAV←SAV+1;
	ROWCHK(CHKROW,ROWS,SAV,50);
	END;
    RETURN(OBUF);
    END "CROPX";


INTERNAL PROCEDURE CROPPL(INTEGER BUFF,OBUF,SI,EI,SJ,EJ,PI,PJ);
    BEGIN "CROPPL"
    INTEGER I,J,PTR,OPTR,SAVPI,tmp;
    SAVPI←PI;
    FOR I←SI STEP 1 UNTIL EI DO
	BEGIN
	PTR←INPTR(I,SJ,BUFF);
	OPTR←OUTPTR(SAVPI,PJ,OBUF);
	FOR J←SJ STEP 1 UNTIL EJ DO
		COMMENT if tmp←ildb(ptr) then idpb(tmp,optr) else ibp(optr);
		IDPB(ILDB(PTR),OPTR);
	SAVPI←SAVPI+1;
	END;
    END "CROPPL";
END "CROP";